home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form MainForm BorderStyle = 3 'Fixed Dialog ClientHeight = 6105 ClientLeft = 1320 ClientTop = 1575 ClientWidth = 6750 BeginProperty Font name = "System" charset = 0 weight = 700 size = 9.75 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 6510 Icon = "main.frx":0000 Left = 1260 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6105 ScaleWidth = 6750 Top = 1230 Width = 6870 Begin VB.CommandButton AboutBtn Caption = "&About" Height = 375 Left = 4080 TabIndex = 18 Top = 5640 Width = 1215 End Begin VB.CommandButton HelpBtn Caption = "&Help" Height = 375 Left = 2760 TabIndex = 17 Top = 5640 Width = 1215 End Begin VB.Frame Frame1 Caption = "Settings" Height = 3255 Left = 120 TabIndex = 2 Top = 2280 Width = 6495 Begin VB.CheckBox DaylightSavingsCheckBox Caption = "&USA Daylight Savings Time" Height = 255 Left = 2520 TabIndex = 11 Top = 1680 Width = 3735 End Begin VB.TextBox PrefixEdit Height = 360 Left = 4440 TabIndex = 6 Top = 360 Width = 1695 End Begin VB.Label AttemptsLabel Height = 255 Left = 2040 TabIndex = 14 Top = 2760 Width = 4095 End Begin VB.Label QuitLabel Height = 255 Left = 120 TabIndex = 12 Top = 2400 Width = 6015 End Begin ComctlLib.Slider QuitSlider Height = 375 Left = 120 TabIndex = 13 Top = 2760 Width = 1575 _Version = 65536 _ExtentX = 2778 _ExtentY = 661 _StockProps = 64 LargeChange = 10 Max = 100 Min = 1 SelStart = 1 TickFrequency = 10 Value = 1 End Begin ComctlLib.Slider LocalTimeSlider Height = 375 Left = 120 TabIndex = 10 Top = 1680 Width = 1575 _Version = 65536 _ExtentX = 2778 _ExtentY = 661 _StockProps = 64 SmallChange = 5 Max = 125 Min = -125 TickFrequency = 5 End Begin VB.Label LocalTimeLabel Height = 240 Left = 120 TabIndex = 9 Top = 1320 Width = 5895 End Begin VB.Label CommPortLabel Height = 240 Left = 120 TabIndex = 3 Top = 360 Width = 1815 End Begin ComctlLib.Slider CommPortSlider Height = 375 Left = 120 TabIndex = 4 Top = 720 Width = 1215 _Version = 65536 _ExtentX = 2143 _ExtentY = 661 _StockProps = 64 LargeChange = 1 Max = 4 Min = 1 SelStart = 1 Value = 1 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Phone Number:" Height = 240 Left = 2040 TabIndex = 7 Top = 840 Width = 1500 End Begin VB.Label PhoneNumberLabel Caption = "494-4774" Height = 255 Left = 3720 TabIndex = 8 Top = 840 Width = 2415 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Phone &Number Prefix:" Height = 240 Left = 2040 TabIndex = 5 Top = 360 Width = 2130 End End Begin VB.ListBox TerminalWindowListBox Height = 1740 Left = 120 TabIndex = 1 Top = 360 Width = 6495 End Begin VB.CommandButton HangupBtn Caption = "Ha&ngup" Height = 375 Left = 1440 TabIndex = 16 Top = 5640 Width = 1215 End Begin VB.CommandButton ExitBtn Caption = "E&xit" Height = 375 Left = 5400 TabIndex = 19 Top = 5640 Width = 1215 End Begin VB.CommandButton SetClockBtn Caption = "&Set Clock" Height = 375 Left = 120 TabIndex = 15 Top = 5640 Width = 1215 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "&Terminal Window:" Height = 240 Left = 120 TabIndex = 0 Top = 0 Width = 1755 End Begin MSCommLib.MSComm Comm Left = 4800 Top = 120 _Version = 65536 _ExtentX = 847 _ExtentY = 847 _StockProps = 0 CDTimeout = 0 CommPort = 1 CTSTimeout = 0 DSRTimeout = 0 DTREnable = -1 'True Handshaking = 0 InBufferSize = 1024 InputLen = 0 Interval = 1000 NullDiscard = 0 'False OutBufferSize = 512 ParityReplace = "?" RThreshold = 0 RTSEnable = 0 'False Settings = "9600,n,8,1" SThreshold = 0 End Attribute VB_Name = "MainForm" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Const ProgramName = "Atomic" Const ProgramLongName = "Atomic Clock" Const Settings = "Settings" Const CommPort = "CommPort" Const Prefix = "PhoneNumberPrefix" Const LocalTimeZone = "LocalTimeZone" Const USADaylightSavings = "USADaylightSavings" Const Attempts = "Attempts" Private Sub SetDateAndTime(ByVal D As Date) Dim DateStr As String Dim TimeStr As String Date = D Time = TimeSerial(Hour(D), Minute(D), Second(D)) DateStr = Trim(Str(Month(D))) + "/" + Trim(Str(Day(D))) + "/" + Trim(Str(Year(D))) TimeStr = Format(Hour(D), "00") + ":" + Format(Minute(D), "00") + ":" + Format(Second(D), "00") AttemptsLabel = "Set clock to " + DateStr + " " + TimeStr End Sub Private Sub HangUp() If Comm.PortOpen Then UpdateStatus "Hanging Up..." Comm.Output = "%" Comm.PortOpen = False UpdateStatus "Off Hook" End If End Sub Private Function IsDigit(ByVal Ch As String) As Boolean IsDigit = Ch >= "0" And Ch <= "9" End Function Private Function SetClock() As Boolean Dim Line As String Dim Tmp As String Dim I As Integer Dim Ch As String Dim TimeUpdated As Boolean Dim InputReceived As Boolean Dim Status As Integer 'Hang up if necessary. If Comm.PortOpen Then Comm.PortOpen = False End If Comm.Settings = "9600,N,8,1" Comm.InBufferSize = 1024 Comm.OutBufferSize = 1024 Comm.InputLen = 0 Comm.InBufferCount = 0 Comm.RThreshold = 1 Comm.SThreshold = 1 Comm.Handshaking = comRTS Comm.CommPort = CommPortSlider.Value 'Open the port. Comm.PortOpen = True Comm.Output = "ATDT " + PhoneNumberLabel.Caption + Chr(13) + Chr(10) If Comm.InBufferCount > 0 Then If Not InputReceived Then UpdateStatus "Receiving Time Data..." End If InputReceived = True Tmp = Comm.Input For I = 1 To Len(Tmp) Ch = Mid(Tmp, I, 1) If (Ch = Chr(13)) Then Line = Trim(Line) Line = UCase(Line) 'Loop on error. If InStr(Line, "BUSY") <> 0 Or InStr(Line, "NO CARRIER") Then TerminalWindowListBox.AddItem (Line) HangUp SetClock = False Exit Function End If TimeUpdated = UpdateTime(Line) TerminalWindowListBox.AddItem (Line) TerminalWindowListBox.TopIndex = TerminalWindowListBox.ListCount - 1 Line = "" Else If (Ch <> Chr(10)) Then Line = Line + Ch End If End If Next End If Status = DoEvents() Loop HangUp SetClock = TimeUpdated End Function Private Sub UpdateLocalTimeLabel() Dim Sign As String * 1 Dim USATimeZone As String If LocalTimeSlider.Value < 0 Then Sign = "-" Else Sign = "+" End If Select Case LocalTimeSlider.Value Case -7 * 10: USATimeZone = " (USA Mountain Time Zone)" Case -6 * 10: USATimeZone = " (USA Central Time Zone)" Case -5 * 10: USATimeZone = " (USA Eastern Time Zone)" End Select LocalTimeLabel.Caption = "&Local Time = UT " + Sign + Format(LocalTimeSlider.Value / 10#, "#0.0") + USATimeZone End Sub Private Sub UpdateQuitLabel() QuitLabel = "&Quit after " + Trim(Str(QuitSlider.Value)) + " unsuccessful attempts" End Sub Sub UpdateStatus(ByVal Text As String) Caption = ProgramLongName If Len(Text) > 0 Then Caption = Caption + " - " + Text End If End Sub Private Function UpdateTime(ByVal Line As String) As Boolean Dim Numbers(11) As Long Dim I As Integer Dim Number As String Dim Ch As String * 1 Dim Index As Integer Dim AllNumbersFound As Boolean Dim DST As Boolean Dim TimeCorrection As Integer Dim AtomicDate As Date Dim AtomicTime As Date Dim LocalDate As Date If IsDigit(Mid(Line, 1, 1)) Then For I = 1 To Len(Line) Ch = Mid(Line, I, 1) If IsDigit(Ch) Then Number = Number + Ch Else Numbers(Index) = Val(Number) Index = Index + 1 Number = "" If Index = 11 Then AllNumbersFound = True Exit For End If End If Next I End If If AllNumbersFound Then HangUp TimeCorrection = LocalTimeSlider.Value \ 10 AtomicDate = DateSerial(1900 + Numbers(1), Numbers(2), Numbers(3)) AtomicTime = TimeSerial(Numbers(4), Numbers(5), Numbers(6)) AtomicDate = AtomicDate + AtomicTime LocalDate = AtomicDate + (TimeCorrection / 24#) 'Adjust for Daylight Savings if necessary. If DaylightSavingsCheckBox.Value Then Select Case Numbers(7) Case 0: DST = False Case 1: DST = Hour(LocalDate) < 2 Case 2 To 49: DST = True Case 50: DST = True Case 51: DST = Hour(LocalDate) >= 2 Case 52 To 99: DST = False End Select If DST Then LocalDate = LocalDate + 1# / 24# End If End If SetDateAndTime LocalDate End If UpdateTime = AllNumbersFound End Function Private Sub UpdateCommPortLabel() CommPortLabel.Caption = "&Comm Port (" + Trim(Str(CommPortSlider.Value)) + "):" End Sub Private Sub AboutBtn_Click() Dim NewLine As String Dim Msg As String NewLine = Chr(10) + Chr(13) Msg = "Atomic Clock sets your computer's clock using the National Institute of Standards and Technology's atomic clock located in Boulder, Colorado, USA" + NewLine + NewLine + "Written by Eric Bergman-Terrell" + NewLine + NewLine + "This program is FREEWARE." MsgBox Msg, vbInformation, "About Atomic Clock v. 1.01" End Sub Private Sub CommPortSlider_Change() UpdateCommPortLabel End Sub Private Sub ExitBtn_Click() Unload MainForm End Sub Private Sub Form_Load() Dim Port As Integer Dim I As Integer Dim Value As Integer Dim TimeZone As Integer Dim NumAttempts As Integer CenterForm Me UpdateStatus "" Port = GetSetting(ProgramName, Settings, CommPort, 1) If Port < CommPortSlider.Min Or Port > CommPortSlider.Max Then Port = 1 End If CommPortSlider.Value = Port UpdateCommPortLabel PrefixEdit.Text = GetSetting(ProgramName, Settings, Prefix, "1-(303)") TimeZone = GetSetting(ProgramName, Settings, LocalTimeZone, -7 * 10) If TimeZone < LocalTimeSlider.Min Or TimeZone > LocalTimeSlider.Max Then TimeZone = -7 * 10 End If LocalTimeSlider.Value = TimeZone UpdateLocalTimeLabel If GetSetting(ProgramName, Settings, USADaylightSavings, True) Then DaylightSavingsCheckBox.Value = 1 End If NumAttempts = Val(GetSetting(ProgramName, Settings, Attempts)) If NumAttempts < QuitSlider.Min Or NumAttempts > QuitSlider.Max Then NumAttempts = 10 End If QuitSlider.Value = NumAttempts UpdateQuitLabel End Sub Private Sub Form_UnLoad(Cancel As Integer) HangUp SaveSetting ProgramName, Settings, CommPort, CommPortSlider.Value SaveSetting ProgramName, Settings, LocalTimeZone, LocalTimeSlider.Value SaveSetting ProgramName, Settings, USADaylightSavings, DaylightSavingsCheckBox.Value SaveSetting ProgramName, Settings, Attempts, QuitSlider.Value End End Sub Private Sub HangupBtn_Click() HangUp End Sub Private Sub HelpBtn_Click() Dim NewLine As String Dim Msg As String NewLine = Chr(10) + Chr(13) Msg = "To set your computer's clock:" + NewLine + NewLine + "1. Specify your modem's Comm Port." + NewLine + NewLine + "2. Enter the appropriate Phone Number Prefix. Users outside of the (303) area code should enter a Phone Number Prefix of 1-(303)." + NewLine + NewLine + "3. Specify your Local Time (number of hours that your local time differs from UT.)" + NewLine + NewLine + "4. Specify whether or not to use USA Daylight Savings Time." + NewLine + NewLine + "5. Specify the number of attempts to make before quitting." + NewLine + NewLine + "6. Press Set Clock" + NewLine + NewLine + "After setting your computer's clock, Atomic Clock will automitically hang up the connection. Press Hangup to terminate the connection immediately." MsgBox Msg, vbInformation, "Atomic Clock Help" End Sub Private Sub LocalTimeSlider_Change() Dim NewValue As Integer NewValue = (LocalTimeSlider.Value \ 5) * 5 If NewValue <> CommPortSlider.Value Then LocalTimeSlider.Value = NewValue End If UpdateLocalTimeLabel End Sub Private Sub PrefixEdit_Change() PhoneNumberLabel = PrefixEdit.Text + "494-4774" SaveSetting ProgramName, Settings, Prefix, PrefixEdit.Text End Sub Private Sub QuitSlider_Change() UpdateQuitLabel End Sub Private Sub SetClockBtn_Click() Dim NumAttempts As Integer Dim Success As Boolean NumAttempts = NumAttempts + 1 AttemptsLabel = "Attempt " + Trim(Val(NumAttempts)) + " of " + Trim(Val(QuitSlider.Value)) Success = SetClock Loop Until Success Or NumAttempts >= QuitSlider.Value If Not Success Then AttemptsLabel = "Failed to connect in " + Trim(Val(QuitSlider.Value)) + " attempts" End If End Sub 
(.txt)